;;; a view that displays an image

(in-package :gwee)

(defclass image (view)
  ((source :initarg :source :accessor image-source)
   (surface :accessor image-surface)
   (horizontal-gravity :initform :center :initarg :horizontal-gravity :accessor image-horizontal-gravity)
   (vertical-gravity :initform :center :initarg :horizontal-gravity :accessor image-vertical-gravity)))

(defgeneric load-image-source (source)
  (:documentation "Return an sdl:surface of SOURCE."))

;; FIXME: is distinguishing between a string and pathname useful or wise?

(defmethod load-image-source ((source string))
  "If you give it a string, assume it's a file relative to gwee data's dir."
  (or (sdl:load-and-convert-image (resource source))
      (error "Cannot load image ~s" source)))

(defmethod load-image-source ((source pathname))
  "If you give a pathname, assume it's an absolute location."
  (or (sdl:load-and-convert-image (namestring source))
      (error "Cannot load image ~s" source)))

(defmethod load-image-source ((source sdl:surface))
  source)

(defmethod shared-initialize :after ((obj image) slot-names &key scale)
  (unless (slot-boundp obj 'width)
    (setf (view-width obj) (sdl:width (image-surface obj))))
  (unless (slot-boundp obj 'height)
    (setf (view-height obj) (sdl:height (image-surface obj))))
  ;; FIXME: scale should be a slot and update dynamically when the view resizes
  (setf (image-surface obj) (case scale
			      (:stretch
				(let ((surface (load-image-source (image-source obj))))
				  (sdl:zoom-surface (/ (- (view-width obj) 2) (sdl:width surface))
                                                    (/ (- (view-height obj) 2) (sdl:height surface))
                                                    :surface surface
                                                    :smooth t)))
			      (:fit
				(let* ((surface (load-image-source (image-source obj)))
				       (xratio (/ (- (view-width obj) 2) (sdl:width surface)))
				       (yratio (/ (- (view-height obj) 2) (sdl:height surface))))
				  (if (and (<= (* xratio (sdl:height surface)) (view-width obj))
					   (<= (* xratio (sdl:height surface)) (view-height obj)))
				      (sdl:zoom-surface xratio xratio :surface surface :smooth t)
				      (sdl:zoom-surface yratio yratio :surface surface :smooth t))))
			      (t
			       (load-image-source (image-source obj))))))

(defmethod draw-view ((obj image))
  (let ((ofs-x (ecase (image-horizontal-gravity obj)
		 (:center
		  (truncate (- (view-width obj)
			       (sdl:width (image-surface obj)))
			    2))
		 (:left 0)
		 (:right
		  (- (view-width obj)
		     (sdl:width (image-surface obj))))))
	(ofs-y (ecase (image-vertical-gravity obj)
		 (:center
		  (truncate (- (view-height obj)
			       (sdl:height (image-surface obj)))
			    2))
		 (:top 0)
		 (:bottom
		  (- (view-height obj)
		     (sdl:height (image-surface obj)))))))
    (sdl:draw-surface-at-* (image-surface obj)
			   (+ (view-cache-top-x obj) ofs-x)
			   (+ (view-cache-top-y obj) ofs-y))))
